home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pas_all.zip / TI993.ASC < prev    next >
Text File  |  1992-04-28  |  8KB  |  397 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  9.   VERSION  :  6.0
  10.        OS  :  DOS
  11.      DATE  :  April 28, 1992                           PAGE  :  1/6
  12.  
  13.     TITLE  :  Different Colors in Turbo Vision.
  14.  
  15.  
  16.  
  17.  
  18.   Program ColorTV;
  19.  
  20.   uses Objects, Drivers, Views, Menus, Dialogs, App, StdInput;
  21.  
  22.   const
  23.     cmButton  = 101;
  24.     cmNewWin  = 102;
  25.     cmNewDlg  = 103;
  26.  
  27.     WinCount : integer = 0;  { number of current windows }
  28.  
  29.   type
  30.  
  31.     PApp = ^TApp;
  32.     TApp = object(TApplication)
  33.       procedure InitMenuBar; virtual;
  34.       procedure InitStatusLine; virtual;
  35.       procedure HandleEvent(var Event : TEvent); virtual;
  36.       procedure NewWindow;
  37.       procedure NewDialog;
  38.       function  GetPalette : PPalette; virtual;
  39.     end;
  40.  
  41.     PWin = ^TWin;
  42.     TWin = object(TWindow)
  43.       constructor Init(Bounds: TRect; WinTitle: String;
  44.                        WindowNo: Word);
  45.       function GetPalette : PPalette; virtual;
  46.     end;
  47.  
  48.     PInLine = ^TInLine;
  49.     TInLine = object(TInputReal)
  50.       function GetPalette : PPalette; virtual;
  51.     end;
  52.  
  53.     PDlg = ^TDlg;
  54.     TDlg = object(TDialog)
  55.       function GetPalette : PPalette; virtual;
  56.     end;
  57.  
  58.  
  59.   { TWin }
  60.   constructor TWin.Init(Bounds: TRect; WinTitle: String;
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  75.   VERSION  :  6.0
  76.        OS  :  DOS
  77.      DATE  :  April 28, 1992                           PAGE  :  2/6
  78.  
  79.     TITLE  :  Different Colors in Turbo Vision.
  80.  
  81.  
  82.  
  83.  
  84.                         WindowNo: Word);
  85.   var
  86.     S : string[3];
  87.     R : TRect;
  88.     MyInputLine : PInLine;
  89.   begin
  90.     Str(WindowNo, S);
  91.     TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  92.     GetClipRect(Bounds);
  93.     Bounds.Grow(-1,-1);
  94.  
  95.     { insert input string }
  96.     R.Assign(8, 2, 20, 3);
  97.     Insert(New(PInLine, Init(R, 12)));
  98.  
  99.     { insert button }
  100.     R.Assign(8, 5, 20, 7);
  101.     Insert(New(PButton, Init(R, '~O~k', cmButton, bfDefault)));
  102.  
  103.     { move to the top }
  104.     SelectNext(false);
  105.  
  106.   end;
  107.  
  108.   function TWin.GetPalette : PPalette;
  109.   { add color indexes to TWin to allow button to be displayed in }
  110.   { the window.  notice that TButton's palette starts mapping    }
  111.   { from 10 - 15, and TWindow's palette runs from 1 - 8, there-  }
  112.   { fore add the indexes for the button on the end of TWin       }
  113.   { palettes.                                                    }
  114.   const
  115.     CWin = CBlueWindow + #0#41#42#43#44#45#64;
  116.     PWin : string[Length(CWin)] = CWin;
  117.   begin
  118.     GetPalette := @ PWin;
  119.   end;
  120.  
  121.   { TApp }
  122.   procedure TApp.InitMenuBar;
  123.   var
  124.     Menu: TRect;
  125.   begin
  126.     GetExtent(Menu);
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  141.   VERSION  :  6.0
  142.        OS  :  DOS
  143.      DATE  :  April 28, 1992                           PAGE  :  3/6
  144.  
  145.     TITLE  :  Different Colors in Turbo Vision.
  146.  
  147.  
  148.  
  149.  
  150.     Menu.B.Y := Menu.A.Y + 1;
  151.     MenuBar := New(PMenuBar, Init(Menu, NewMenu(
  152.       NewSubMenu('~W~indow', hcNoContext, NewMenu(
  153.         NewItem('~W~indow', '', kbF4, cmNewWin, hcNoContext,
  154.         NewItem('~D~ialog', '', kbF5, cmNewDlg, hcNoContext,
  155.         NewLine(
  156.         NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
  157.         NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  158.         nil)))))),
  159.       nil))));
  160.   end;
  161.  
  162.   procedure TApp.InitStatusLine;
  163.   var
  164.     Line: TRect;
  165.   begin
  166.     GetExtent(Line);
  167.     Line.A.Y := Line.B.Y-1;
  168.     StatusLine := New(PStatusLine, Init(Line,
  169.       NewStatusDef(0, $FFFF,
  170.         NewStatusKey('', kbF10, cmMenu,
  171.         NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  172.         NewStatusKey('~F4~ Window', kbF4, cmNewWin,
  173.         NewStatusKey('~F5~ Dialog', kbF5, cmNewDlg,
  174.         NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  175.         nil))))),
  176.       nil)));
  177.   end;
  178.  
  179.   procedure TApp.NewWindow;
  180.   var
  181.     Window : PWin;
  182.     Box    : TRect;
  183.   begin
  184.     Inc(WinCount);
  185.     Box.Assign(0, 0, 30, 8);
  186.     Box.Move(Random(34), Random(11));
  187.     Window := New(PWin, Init(Box, 'Test Window', WinCount));
  188.     DeskTop^.Insert(Window);
  189.   end;
  190.  
  191.   procedure TApp.HandleEvent(var Event: TEvent);
  192.   begin
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  207.   VERSION  :  6.0
  208.        OS  :  DOS
  209.      DATE  :  April 28, 1992                           PAGE  :  4/6
  210.  
  211.     TITLE  :  Different Colors in Turbo Vision.
  212.  
  213.  
  214.  
  215.  
  216.     TApplication.HandleEvent(Event);
  217.     if Event.What = evCommand then
  218.     begin
  219.       case Event.Command of
  220.         cmNewWin : NewWindow;
  221.         cmNewDlg : NewDialog;
  222.         cmButton : ;
  223.       else
  224.         Exit;
  225.       end;
  226.       ClearEvent(Event);
  227.     end;
  228.   end;
  229.  
  230.   procedure TApp.NewDialog;
  231.   var
  232.     Dialog     : PDlg;
  233.     R          : TRect;
  234.     C          : Word;
  235.   begin
  236.  
  237.     R.Assign(25, 5, 55, 13);
  238.     Dialog := New(PDlg, Init(R, 'Test Dialog'));
  239.  
  240.     with Dialog^ do
  241.     begin
  242.  
  243.       { message }
  244.       R.Assign(9, 2, 27, 3);
  245.       Insert(New(PStaticText, Init(R, 'Error Message')));
  246.  
  247.       { insert button }
  248.       R.Assign(10, 5, 20, 7);
  249.       Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  250.  
  251.     end;
  252.  
  253.     C := DeskTop^.ExecView(Dialog);
  254.  
  255.     Dispose(Dialog, Done);
  256.   end;
  257.  
  258.   function TApp.GetPalette : PPalette;
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  273.   VERSION  :  6.0
  274.        OS  :  DOS
  275.      DATE  :  April 28, 1992                           PAGE  :  5/6
  276.  
  277.     TITLE  :  Different Colors in Turbo Vision.
  278.  
  279.  
  280.  
  281.  
  282.   { this is the palette that all other views are mapped to. }
  283.   { the first 64 (0..63) are defined, any other colors are  }
  284.   { added from 64 on.  the #$10 is for TWin for the back-   }
  285.   { ground color for the button.  from $47 on maps the new  }
  286.   { color for TDlg and its views.                           }
  287.   const
  288.     CApp = CColor + #$10#$47#$4E#$40#$4F#$30#$3E;
  289.     PApp : string[Length(CApp)] = CApp;
  290.   begin
  291.     GetPalette := @ PApp;
  292.   end;
  293.  
  294.   { TInLine }
  295.   function TInLine.GetPalette : PPalette;
  296.   { color indexes into TWin color palette }
  297.   const
  298.     CInLine = #4#4#3#3;
  299.     PInLine : string[Length(CInLine)] = CInLine;
  300.   begin
  301.     GetPalette := @ PInLine;
  302.   end;
  303.  
  304.   { TDlg }
  305.   function TDlg.GetPalette : PPalette;
  306.   { when replacing colors for a view must replace the entire   }
  307.   { string.  notice that any color > 63 maps to a user defined }
  308.   { color from TApp's palette (65 = $47, 66 = $4E, etc.).      }
  309.   { i.e.                                                       }
  310.   { index 2, the active frame maps to 65 which is color $47    }
  311.   {          (or grey on red).                                 }
  312.   { index 3, the frame icon maps to 66->$4E (yellow on red).   }
  313.   { index 46, the button shadow maps to 67->$40 (black on rec).}
  314.   { index 37, the statictext maps to 68->$47 (white on red).   }
  315.   {           (no reason 46 is before 38).                     }
  316.   { index 41-43, button stuff 69->$30 (cyan on black).         }
  317.   { index 45, button shortcut 70->$3E (cyan on yellow).        }
  318.   const
  319.     CDlg = #32#65#66#35#36#68#38#39#40#69#69#69#44#70#67#47#48#49 +
  320.            #50#51#52#53#54#55#56#57#58#59#60#61#62#63;
  321.     PDlg : string[Length(CDlg)] = CDlg;
  322.   begin
  323.    GetPalette := @ PDlg;
  324.   end;
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  339.   VERSION  :  6.0
  340.        OS  :  DOS
  341.      DATE  :  April 28, 1992                           PAGE  :  6/6
  342.  
  343.     TITLE  :  Different Colors in Turbo Vision.
  344.  
  345.  
  346.  
  347.  
  348.   var
  349.     MyApp : TApp;
  350.  
  351.   { main }
  352.   begin
  353.  
  354.     MyApp.Init;
  355.     MyApp.Run;
  356.     MyApp.Done;
  357.  
  358.   end.
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.